home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / OldSrc / CH10 / SRC / OBJROTAT.CLS < prev    next >
Text File  |  1996-05-04  |  7KB  |  248 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "ObjRotated"
  6. Attribute VB_Creatable = False
  7. Attribute VB_Exposed = False
  8. Option Explicit
  9.  
  10. Private NumCurvePts As Integer
  11. Private CurvePoints() As Point3D
  12.  
  13. Private pline As ObjPolyline    ' The display polyline.
  14.  
  15. ' ************************************************
  16. ' Add a point to the curve.
  17. ' ************************************************
  18. Public Sub AddCurvePoint(x As Single, y As Single, z As Single)
  19.     NumCurvePts = NumCurvePts + 1
  20.     ReDim Preserve CurvePoints(1 To NumCurvePts)
  21.     CurvePoints(NumCurvePts).coord(1) = x
  22.     CurvePoints(NumCurvePts).coord(2) = y
  23.     CurvePoints(NumCurvePts).coord(3) = z
  24.     CurvePoints(NumCurvePts).coord(4) = 1
  25. End Sub
  26.  
  27. ' ************************************************
  28. ' Create the display polyline by rotating around
  29. ' the Y axis.
  30. ' ************************************************
  31. Public Sub Rotate()
  32. Dim i As Integer
  33. Dim r As Single
  34. Dim theta As Single
  35. Dim dtheta As Single
  36. Dim t As Single
  37. Dim x As Single
  38. Dim z As Single
  39. Dim x1 As Single
  40. Dim y1 As Single
  41. Dim z1 As Single
  42. Dim x2 As Single
  43. Dim y2 As Single
  44. Dim z2 As Single
  45.  
  46.     Set pline = New ObjPolyline
  47.         
  48.     ' Create the translated images of the curve.
  49.     dtheta = PI / 8
  50.     For theta = 0 To 2 * PI - dtheta + 0.01 Step dtheta
  51.         x = CurvePoints(1).coord(1)
  52.         z = CurvePoints(1).coord(3)
  53.         r = Sqr(x * x + z * z)
  54.         t = Arctan2(x, z)
  55.         x1 = r * Cos(t + theta)
  56.         y1 = CurvePoints(1).coord(2)
  57.         z1 = r * Sin(t + theta)
  58.         For i = 2 To NumCurvePts
  59.             x = CurvePoints(i).coord(1)
  60.             z = CurvePoints(i).coord(3)
  61.             r = Sqr(x * x + z * z)
  62.             t = Arctan2(x, z)
  63.             x2 = r * Cos(t + theta)
  64.             y2 = CurvePoints(i).coord(2)
  65.             z2 = r * Sin(t + theta)
  66.             
  67.             pline.AddSegment x1, y1, z1, x2, y2, z2
  68.             x1 = x2
  69.             y1 = y2
  70.             z1 = z2
  71.         Next i
  72.     Next theta
  73.  
  74.     ' Create the circles of rotation.
  75.     For i = 1 To NumCurvePts
  76.         x = CurvePoints(i).coord(1)
  77.         z = CurvePoints(i).coord(3)
  78.         r = Sqr(x * x + z * z)
  79.         t = Arctan2(x, z)
  80.         x1 = r * Cos(t)
  81.         y1 = CurvePoints(i).coord(2)
  82.         z1 = r * Sin(t)
  83.         For theta = dtheta To 2 * PI - dtheta + 0.01 Step dtheta
  84.             x2 = r * Cos(t + theta)
  85.             z2 = r * Sin(t + theta)
  86.             pline.AddSegment x1, y1, z1, x2, y1, z2
  87.             x1 = x2
  88.             z1 = z2
  89.         Next theta
  90.         x2 = r * Cos(t)
  91.         z2 = r * Sin(t)
  92.         pline.AddSegment x1, y1, z1, x2, y1, z2
  93.     Next i
  94. End Sub
  95.  
  96. ' ***********************************************
  97. ' Return a string indicating the object type.
  98. ' ***********************************************
  99. Property Get ObjectType() As String
  100.     ObjectType = "ROTATED"
  101. End Property
  102.  
  103.  
  104.  
  105. ' ***********************************************
  106. ' Fix the data coordinates at their transformed
  107. ' values.
  108. ' ***********************************************
  109. Public Sub FixPoints()
  110. Dim i As Integer
  111. Dim j As Integer
  112.  
  113.     ' Fix the curve points.
  114.     For i = 1 To NumCurvePts
  115.         For j = 1 To 3
  116.             CurvePoints(i).coord(j) = CurvePoints(i).trans(j)
  117.         Next j
  118.     Next i
  119.  
  120.     ' Fix the display polyline if it exists.
  121.     If Not pline Is Nothing Then pline.FixPoints
  122. End Sub
  123.  
  124. ' ************************************************
  125. ' Apply a transformation matrix which may not
  126. ' contain 0, 0, 0, 1 in the last column to the
  127. ' object.
  128. ' ************************************************
  129. Public Sub ApplyFull(M() As Single)
  130. Dim i As Integer
  131.  
  132.     ' Transform the curve.
  133.     For i = 1 To NumCurvePts
  134.         m3ApplyFull CurvePoints(i).coord, M, _
  135.                     CurvePoints(i).trans
  136.     Next i
  137.     
  138.     ' Transform the display polyline if it exists.
  139.     If Not pline Is Nothing Then pline.ApplyFull M
  140. End Sub
  141.  
  142. ' ************************************************
  143. ' Apply a transformation matrix to the object.
  144. ' ************************************************
  145. Public Sub Apply(M() As Single)
  146. Dim i As Integer
  147.  
  148.     ' Transform the curve.
  149.     For i = 1 To NumCurvePts
  150.         m3Apply CurvePoints(i).coord, M, _
  151.                 CurvePoints(i).trans
  152.     Next i
  153.     
  154.     ' Transform the display polyline if it exists.
  155.     If Not pline Is Nothing Then pline.Apply M
  156. End Sub
  157.  
  158.  
  159. ' ************************************************
  160. ' Apply a nonlinear transformation.
  161. ' ************************************************
  162. Public Sub Distort(D As Object)
  163. Dim i As Integer
  164.  
  165.     ' Distort the curve.
  166.     For i = 1 To NumCurvePts
  167.         D.Distort CurvePoints(i).coord(1), _
  168.                   CurvePoints(i).coord(2), _
  169.                   CurvePoints(i).coord(3)
  170.     Next i
  171.     
  172.     ' Distort the display polyline if it exists.
  173.     If Not pline Is Nothing Then pline.Distort D
  174. End Sub
  175.  
  176.  
  177. ' ************************************************
  178. ' Write the surface's display polyline object to a
  179. ' file using Write. The data can later be loaded
  180. ' into an ObjPolyline object but not an
  181. ' ObjRotated object.
  182. ' ************************************************
  183. Public Sub FileWritePolyline(filenum As Integer)
  184.     If Not pline Is Nothing Then pline.FileWrite filenum
  185. End Sub
  186.  
  187.  
  188. ' ************************************************
  189. ' Write an extruded surface to a file using Write.
  190. ' Begin with "ROTATED" to identify this object.
  191. ' ************************************************
  192. Public Sub FileWrite(filenum As Integer)
  193. Dim i As Integer
  194.  
  195.     ' Write basic information.
  196.     Write #filenum, "ROTATED", NumCurvePts
  197.         
  198.     ' Write the curve points.
  199.     For i = 1 To NumCurvePts
  200.         Write #filenum, _
  201.             CurvePoints(i).coord(1), _
  202.             CurvePoints(i).coord(2), _
  203.             CurvePoints(i).coord(3)
  204.     Next i
  205. End Sub
  206.  
  207.  
  208.  
  209.  
  210. ' ************************************************
  211. ' Draw the extrusion on a Form, Printer, or
  212. ' PictureBox.
  213. ' ************************************************
  214. Public Sub Draw(canvas As Object, Optional r As Variant)
  215.     If Not pline Is Nothing Then _
  216.         pline.Draw canvas, r
  217. End Sub
  218.  
  219.  
  220. ' ************************************************
  221. ' Read a grid from a file using Input.
  222. ' Assume the "ROTATED" label has already been
  223. ' read.
  224. ' ************************************************
  225. Public Sub FileInput(filenum As Integer)
  226. Dim i As Integer
  227.  
  228.     ' Get the basic information.
  229.     Input #filenum, NumCurvePts
  230.     
  231.     ' Allocate the curve array.
  232.     ReDim CurvePoints(1 To NumCurvePts)
  233.     
  234.     ' Read the curve points.
  235.     For i = 1 To NumCurvePts
  236.         Input #filenum, _
  237.             CurvePoints(i).coord(1), _
  238.             CurvePoints(i).coord(2), _
  239.             CurvePoints(i).coord(3)
  240.         CurvePoints(i).coord(4) = 1
  241.     Next i
  242.     
  243.     ' Create the display polyline.
  244.     Rotate
  245. End Sub
  246.  
  247.  
  248.